00100	HOPEN:				;OPENS THE HAND TO SET POINT
00200		TRNN HCL
00300		JRST[	MOVEI TAC,=480	;GO HERE FIRST TIME
00400			MOVEM TAC,HCNT	;MAX TIME TO SERVO THERE
00500			ADDI TAC,=60
00600			MOVEM TAC,COUNT
00700			HRLZ AC,@STKPTR	;REQUIRED OPENING
00800			MOVE MQ,[3.6]
00900			CAML AC,MQ
01000			MOVE AC,MQ	;NOT GREATER THAN 2.5
01100			MOVEM AC,RSET	;REQUIRED FINAL SET POINT
01200			PUSHJ P,HEAD	;READS THE HAND
01300			MOVE AC,HAND	;AND STORE IT HERE
01400			MOVEM AC,SET	;DYNAMIC SET POINT
01500			TRZ STCH	;TURN OFF TOUCH AND SAVE STATE
01600			MOVE TAC,[0.2]
01700			CAML AC,RSET
01800			MOVN TAC,TAC
01900			MOVEM TAC,DIR	;CHANGE OF SET POINT PER JIFFY
02000			TRO HCL		;SO THAT WE DON'T COME BACK HERE
02100			JUMPGE TAC,NXTJIF
02200			FSC TAC,-1	;IF CLOSING GO SLOWER
02300			MOVEM TAC,DIR
02400			SKIPE SOTCH	;AND RESTORE TOUCH
02500			TRO STCH
02600			JRST NXTJIF]
02700	HSU:	PUSHJ P, HEAD		;INCREMENTS SETPOINT AND SETS D/A
02800					;LEAVES ARM DATAO IN TAC
02900	IFE HANDWORK <
03000		JRST NEXT
03100	>
03200		SOSGE HCNT
03300		JRST[	MOVEI AC,HTERR
03400			MOVEM AC,TRAJER
03500			POP P,AC
03600			JRST TOFF]
03700		SKIPE DIR
03800		JRST DAW		;IF NOT AT FINAL SET DRIVE ANYWAY
03900		MOVE AC,RSET
04000		FSBR AC,HAND		;CHECK ERROR TOLERANCE
04100		MOVM AC,AC
04200		FSBR AC,[0.05]
04300		JUMPLE AC,[	TRZ HCL
04400				TDZ DATWD,HANDAT
04500				JRST NEXT]
04600	DAW:	
04700	IFN TRACK,<SKIPN WALK>
04800		DATAO ARM,DATWD		;DRIVE HAND
04900		JRST NXTJIF
05000	
     

00100	HCLOSE:
00200		TRNN HCL		;ONLY ONCE
00300		JRST[	TRZ STCH	;TURN OFF TOUCH AND SAVE STATE
00400			MOVEI TAC,=240
00500			MOVEM TAC,COUNT
00600			HRLZ AC,@STKPTR	;MINIMUN OPENING
00700			MOVEM AC,MINDST
00800			PUSHJ P,HEAD	;READ HAND
00900			MOVE AC,HAND
01000			MOVEM AC,SET
01100			MOVE TAC,[-0.10]
01200			MOVEM TAC,DIR	;CHANGE OF SET POINT PER JIFFY
01300			MOVSI AC,(4.0)
01400			MOVNM AC,RSET	;FINAL SET POINT -1 SO AS TO SQUEEZE
01500			TRO HCL
01600			JRST NXTJIF]
01700	BB:	PUSHJ P,HEAD
01800	IFE HANDWORK <
01900		JRST ER2
02000	>
02100	IFN TRACK,<SKIPN WALK>
02200		DATAO ARM,DATWD		;DRIVE HAND
02300		MOVE AC,HERR
02400		CAMG AC,[0.50]
02500		JRST NXTJIF		;IF ERROR LESS THAN 1 KEEP ON
02600	ER2:	TRZ HCL
02700		TDZ DATWD,HANDAT
02800		SKIPE SOTCH		;RESTORE TOUCH
02900		TRO STCH
03000		MOVE AC,MINDST
03100	IFE USER,<CAMG AC,HAND>
03200		JRST NEXT
03300		MOVEI 1,GRASER		;IF LESS THAN MINOPENING GIVE ERROR
03400		MOVEM 1,TRAJER
03500		POP P,1
03600		JRST  TOFF
03700	
     

00100	HEAD:	MOVEI K,HANDCHA
00200	IFE USER,<
00300		PUSHJ P,PREAD		;READ HAND CHANNEL
00400		LDB AC,SNUM
00500		ANDI DACVAL,7777
00600		ADDI AC,(DACVAL)	;ADD ALL THREE READINGS TOGETHER
00700		FSC AC,220
00800		FMPR AC,HSCALE
00900		FADR AC,HOFF
01000		MOVEM AC,HAND		;OPENING IN INCHES
01100	>
01200	IFN USER,<
01300		MOVE AC,HAND
01400		FADR AC,DIR
01500		SKIPG AC
01600		SETZ AC,
01700		MOVEM AC,HAND
01800	>
01900	IFN REPORT,<
02000		PUSH DATA,[<SIXBIT/HAND/>+1]
02100		PUSH DATA,HAND
02200	>
02300		SKIPN TAC,DIR
02400		JRST[	MOVE TAC,SET
02500			JRST GOTHER]
02600		FMPR TAC,TDF
02700		FADRB TAC,SET 		;INCREMENT SET POINT
02800		FSBR TAC,RSET	;NEGATIVE REMAINS TO GO
02900		FMPR TAC,DIR
03000		JUMPGE TAC,[	MOVE TAC,RSET	;GOT THERE
03100				MOVEM TAC,SET
03200				SETZM DIR
03300				JRST GOTHER]
03400		MOVE TAC,SET
     

00100	GOTHER:	FSBR AC,TAC		;HAND SERVO
00200		EXCH AC,HERR
00300		FSBR AC,HERR
00400		FMPR AC,KVH
00500		MOVN TAC,HERR
00600		FMPR TAC,KEH
00700		FADR AC,TAC
00800		TDO DATWD,[HANDAT:XWD 4000,60]
00900		JUMPGE AC,.+2
01000		TRZ DATWD,40
01100		MOVM AC,AC
01200		FIX AC,211000
01300		CAILE AC,776000
01400		MOVEI AC,776000
01500		TRC AC,400000
01600		HRLI AC,6
01700	IFN DEB<
01800		MOVEM AC,HANDAW
01900	>
02000	IFN TRACK,<SKIPN WALK>
02100		DATAO WIDTH,AC
02200		POPJ P,
02300	HSCALE:	1.32
02400	HOFF:	-0.81
02500	DIR:	0			;CHANGE OF SETPOINT PER JIFFY
02600	SET:	0			;DYNAMIC SET POINT
02700	RSET:	0			;FINAL SET POINT
02800	MINDST:	0			;MIN OPENING FOR CLOSE
02900	HERR:	0			;HAND POSITION ERROR
03000	KEH:	5.0			;ERROR GAIN
03100	KVH:	10.0			;VELOCITY GAIN
03200	IFN DEB<
03300	HANDAW:	0
03400	>
03500	
     

00100	PLACE:				;PLACE HAND ON TABLE
00200		TRNN DROP		;ONLY COME HERE ONCE
00300		JRST[	TRO DROP+RUN+VZERO
00400			MOVEI 1,=360
00500			MOVEM 1,COUNT
00600			HRRE 1,@STKPTR
00700			ADDI 1,(CBUF)
00800			HRLI 1,(1)
00900			HRRI 1,DELTH
01000			BLT 1,DELTH+5	;CHANGE OF THETA PER JIFFY
01100			MOVEI 1,=12
01200			MOVEM 1,HCNT	;DON'T STOP FOR THE FIRST 12 JIFFIES
01300			MOVE DATWD,[770000252502]
01400			HRRZM DATWD,FBI
01500			JRST NXTJIF]
01600		SOSL HCNT
01700		JRST NXTJIF
01800	IFN USER,<JRST PLACED>
01900	EXL:	MOVM AC,ET0+1
02000		CAML AC,PLER
02100		JRST PLACED
02200		JRST NXTJIF
02300	PLACED:	SETZM FUNCT
02400		JRST RUDONE
02500	PLER:	0.6
02600	
     

00100	NUDGE:	HRRE TAC,@STKPTR
00200		ADDI TAC,5(CBUF)
00300		MOVEI I,5
00400	NUL1:	MOVE AC,(TAC)
00500		MOVEM AC,DELTH(I)
00600		TRNE NSET
00700		JRST[	FADRM AC,TFF(I)
00800			MOVN AC,AC
00900			FADRM AC,DTH(I)
01000			JRST .+1]
01100		SOJ TAC,
01200		SOJGE I,NUL1
01300		TRZ NSET
01400		HRRE 1,@STKPTR
01500		ADDI 1,6(CBUF)
01600		PUSHJ P,UPDC
01700		HRRE 1,@STKPTR
01800		ADDI 1,6(CBUF)
01900		MOVE 2,7(1)
02000		ASH 2,16
02100		MOVEM 2,NTICKS
02200		ASH 2,-15
02300		ADDI 2,=60
02400		MOVEM 2,COUNT
02500		TRO INCREM+RUN+VZERO
02600		SETZM TICKS
02700		TRZE BOTH
02800		JRST[	AOS AC,STKPTR
02900			HLRE AC,(AC)
03000			MOVEM AC,FUNCT
03100			JRST .+2]
03200		SETZM FUNCT
03300		JRST NXTJIF
03400	
03500	
03600	STOP:	HRRE 1,@STKPTR
03700		ADDI 1,(CBUF)
03800		HRLI 1,(1)
03900		HRRI 1,STQ
04000		BLT 1,STQ+5
04100		MOVEI I,5
04200		SETZ AC,
04300	DSTQ:	MOVE TAC,STQ(I)
04400		FDVR TAC,F0(I)
04500		MOVM MQ,TAC
04600		CAMGE MQ,[0.2]
04700		SETZB TAC,STQ(I)
04800		MOVEM TAC,STQ(I)
04900		FMPR TAC,TAC
05000		FADR AC,TAC
05100		SOJGE I,DSTQ
05200		MOVEM AC,SDTQ
05300		SETZM ASTPP
05400		TRO STP
05500		JRST NEXT
05600	
05700	TOOL:	TRNN HCL
05800		JRST[	HRRE TAC,@STKPTR
05850			MOVM AC,TAC
05875			CAIL AC,100
05900			MOVEI AC,77
06000			JUMPGE TAC,TDIP
06100			TRC AC,177
06200		TDIP:	TRO AC,200
06250			HRRM AC,TDAT
06300			TRO HCL
06400			JRST .+1]
06410		SKIPG COUNT
06420		JRST[	SETZM TDAT
06460			DATAO DEVT,TDAT
06470			TRZ HCL
06480			JRST NEXT]
06500		DATAO DEVT,TDAT
06600		JRST NXTJIF
06700	TDAT:	0
06800	
     

00100	PATH:	TRO RUN+VZERO
00200		AOS DOING	;INCREASE TRAJECTORY NUMBER
00300		HRRE TAC,@STKPTR
00400		ADDI TAC,(CBUF)
00500		HRRZ AC,(TAC)
00600		ASH AC,16
00700		MOVEM AC,NTICKS	;RUN TIME
00800		MOVEI AC,=1800
00900		MOVEM AC,COUNT
01000		SETZM LOOP
01100		MOVE TAC,[XWD LOOP,LOOP+1]
01200		BLT TAC,LOOP+9
01300		MOVEI I,5
01400		HRRE K,@STKPTR
01500		ADDI K,34
01600	SUL:	SUBI K,4
01700		HRLZM K,TJ(I)
01800		HRLZM K,TN(I)
01900		MOVEI TAC,TJ(I)
02000		MOVEM TAC,TP(I)
02100		SETZM DTH(I)
02200		SOJGE I,SUL
02300		SETZM ETIME
02400		PUSHJ P,EVAL
02500		TRZ INCREM
02600		MOVEI I,5
02700	MOVBK:	MOVE AC,TH(I)
02800		MOVEM AC,T0(I)
02900		FSBR AC,TFF(I)
03000		CAIN I,5
03100		JRST[	MOVSI MQ,(180.0)
03200			CAML AC,MQ
03300			JRST[SETROT:FSC MQ,1
03400				MOVN MQ,MQ
03500				FADRM MQ,TH+5
03600				FADRM MQ,ROT6
03700				JRST MOVBK]
03800			MOVN MQ,MQ
03900			CAMG AC,MQ
04000			JRST SETROT
04100			JRST ADDTF]
04200	ADDTF:	MOVEM AC,DTH(I)
04300		MOVN AC,AC
04400		FADRM AC,DELTH(I)
04500		SETZM TD(I)
04600		SOJGE I,MOVBK
04700		SETZM TICKS
04800		TRZE BOTH
04900		JRST[	AOS AC,STKPTR
05000			HLRE AC,(AC)
05100			MOVEM AC,FUNCT
05200			JRST .+2]
05300		SETZM FUNCT
05400		JRST NXTJIF
05500	
     

00100	SAVE:	HRRE K,@STKPTR
00200		ADDI K,(CBUF)
00300		MOVE TAC,(K)
00400		JUMPLE TAC,.+2
00500		CAILE TAC,12
00600		JRST[	MOVEI TAC,SAVERR
00700			MOVEM TAC,TRAJER
00800			JRST TOFF]
00900		IMULI TAC,3
01000		ADDI TAC,DTHS
01100		MOVEI J,2
01200	SAL1:	MOVEI I,5
01300		SOJ TAC,
01400		SETZ AC,
01500	SAL2:	AOJ K,
01600		MOVE MQ,DTH(I)
01700		FMPR MQ,(K)
01800		FADR AC,MQ
01900		SOJGE I,SAL2
02000		MOVEM AC,(TAC)
02100		SOJGE J,SAL1
02200		JRST NEXT
02300	
02400	RESTORE:HRRE K,@STKPTR
02500		ADDI K,(CBUF)
02600		MOVE TAC,(K)
02700		JUMPLE TAC,.+2
02800		CAILE TAC,12
02900		JRST[	MOVEI TAC,SAVERR
03000			MOVEM TAC,TRAJER
03100			JRST TOFF]
03200		IMULI TAC,3
03300		ADDI TAC,DTHS-1
03400		ADDI K,22
03500		MOVEI I,5
03600	REL1:	MOVE AC,(TAC)
03700		FMPR AC,(K)
03800		MOVE MQ,-1(TAC)
03900		FMPR MQ,-1(K)
04000		FADR AC,MQ
04100		MOVE MQ,-2(TAC)
04200		FMPR MQ,-2(K)
04300		FADR AC,MQ
04400		FADRM AC,DDTH(I)
04500		SUBI K,3
04600		SOJGE I,REL1
04700		JRST NEXT
04800	
04900	TIMFAC: 0.3
05000		0.6
05100		3.0
05200		0.3
05300		0.3
05400		0.2
05500	
05600	SET.ARM:HRRE I,@STKPTR
05700		ADDI I,(CBUF)
05800		HRRE AC,(I)
05900		SOJL AC,.+2
06000		CAIL AC,11
06100		JRST[	MOVEI TAC,SAVERR
06200			MOVEM TAC,TRAJER
06300			JRST TOFF]
06400		IMULI AC,3
06500		HRRI TAC,DTHS(AC)
06600		HRRZI MQ,2(TAC)
06700		HRLI TAC,1(I)
06800		BLT TAC,(MQ)
06900		JRST NEXT
07000	
07100	SLAVE:	MOVEI K,15B23
07200		MOVEI I,3
07300	SLRP:	PUSHJ P,PREAD
07400		LDB AC,SNUM
07500		SUBI AC,4000
07600		MOVEM AC,POT(I)
07700		SOJGE I,SLRP
07800		TRNN HCL
07900		JRST[	TRO RUN+VZERO
08000			MOVE DATWD,[770000252502]
08100			HRRZM DATWD,FBI
08200			TRO HCL
08300			MOVEI AC,=6000
08400			MOVEM AC,COUNT
08500			MOVEI I,3
08600		SLZL:	MOVE AC,POT(I)
08700			MOVEM AC,POTZ(I)
08800			SOJGE I,SLZL
08900			JRST .+1]
09000		MOVEI I,3
09100	SLCH:	MOVE AC,POT(I)
09200		SUB AC,POTZ(I)
09300		JUMPGE AC,[SUBI AC,400
09400			JUMPGE AC,SLST
09500			JRST SLZA]
09600		ADDI AC,400
09700		JUMPL AC,SLST
09800	SLZA:	SETZ AC,
09900	SLST:	FSC AC,213
10000		MOVEM AC,POT(I)
10100		SOJGE I,SLCH
10200		SKIPE POT+3
10300		JRST[	TRZ HCL
10400			TRO FINAL
10500			SETZM FUNCT
10600			JRST NXTJIF]
10700		HRRE K,@STKPTR
10800		ADDI K,21(CBUF)
10900		MOVEI I,5
11000	SLL2:	MOVE AC,POT+2
11100		FMPR AC,(K)
11200		MOVE MQ,POT+1
11300		FMPR MQ,-1(K)
11400		FADR AC,MQ
11500		MOVE MQ,POT
11600		FMPR MQ,-2(K)
11700		FADR AC,MQ
11800		FMPR AC,TDF
11900		FADRM AC,DTH(I)
12000		SUBI K,3
12100		SOJGE I,SLL2
12200		JRST NXTJIF
12300	POT:	BLOCK 4
12400	POTZ:	BLOCK 4
12500	
     

00100	CENTER:	TRNN HCL
00200		JRST[	TRO HCL
00300			MOVEI TAC,=600
00400			MOVEM TAC,COUNT
00500			MOVSI AC,(4.0)
00600			MOVNM AC,RSET
00700			PUSHJ P,HEAD
00800			MOVE AC,SET
00900			TRZ STCH
01000			MOVE TAC,[-0.02]
01100			MOVEM TAC,DIR
01200			JRST NXTJIF]
01300		PUSHJ P,HEAD
01400	IFE HANDWORK,<JRST ER2>
01500		DATAO ARM,DATWD
01600		TRNN DROP
01700		JRST[	MOVEI I,1
01800		CFT:	MOVE AC,OBS(I)
01900			JUMPG AC,[SETZM TOT
02000				SKIPN I
02100				AOS TOT
02200				TRO DROP+RUN+VZERO
02300				MOVE TAC,[-0.01]
02400				MOVEM TAC,DIR
02500				HRRE TAC,@STKPTR
02600				ADDI TAC,(CBUF)
02700				MOVE AC,(TAC)
02800				MOVEM AC,MINDST
02900				AOJ TAC,
03000				MOVEI I,DELTH
03100			OT:	MOVE AC,(TAC)
03200				FMPR AC,[0.005]
03300				SKIPN TOT
03400				MOVNS AC
03500				MOVEM AC,(I)
03600				AOJ TAC,
03700				CAIGE I,DELTH+5
03800				AOJA I,OT
03900				MOVE TAC,[XWD 770000, 252500]
04000				HRRZM TAC,FBI
04100				IOR DATWD,TAC
04200				MOVSI AC,(1.0)
04300				MOVEM AC,TDF
04400				MOVEI I,4
04500			GETGO:	PUSHJ P,NXTH
04600				SOJGE I,GETGO
04700				JRST NXTJIF]
04800			SOJGE I,CFT
04900			JRST NXTJIF]
05000		MOVE TAC,TOT
05100		SKIPG OBS(TAC)
05200		JRST NXTJIF
05300		TRZ DROP+RUN+FINAL
05400		PUSHJ P,SETSET
05500		TDZ DATWD,[XWD 770000,252500]
05600		MOVE TAC,DIR
05700		FSC TAC,3
05800		MOVEM TAC,DIR
05900		MOVEI TAC,2
06000		MOVEM TAC,FUNCT
06100		JRST NXTJIF]
06200	TOT:	0
06300	
06400	WOBBLE:	HRLZ AC,@STKPTR
06500		MOVEM AC,WOBMAG
06600		MOVEI AC,1
06700		MOVEM AC,WOBCNT+2
06800		MOVEM AC,WOBCNT+1
06900		MOVEI AC,6
07000		MOVEM AC,WOBCNT
07100		MOVN AC,WOBMAG
07200		FADRM AC,DTH+3
07300		TRO WOB
07400		JRST NEXT
07500	WOBMAG:	0
07600	WOBCNT:	BLOCK 3
07700	SIN:	 0.0
07800		 0.30902
07900		 0.58779
08000		 0.80902
08100		 0.95106
08200		 1.0
08300		 0.95106
08400		 0.80902
08500		 0.58779
08600		 0.30902
08700		 0.0
08800		-0.30902
08900		-0.58779
09000		-0.80902
09100		-0.95106
09200		-1.0
09300		-0.95106
09400		-0.80902
09500		-0.58779
09600		-0.30902
     

00100	SEARCH:	SETZM XSEL
00200		SETZM SCOUNT
00300		SETZM TCOUNT
00400		HRRE 1,@STKPTR
00500		ADDI 1,(CBUF)
00600		HRLI 1,(1)
00700		HRRI 1,XDEL
00800		BLT 1,YDEL+5
00900		SETZM SDTH
01000		MOVE AC,[XWD SDTH,SDTH+1]
01100		BLT AC,SDTH+5
01200		JRST NEXT
01300	
01400	AOJI:	MOVEI I,5
01500		MOVE K,SCOUNT
01600		SOSG J,TCOUNT
01700		JRST[	SKIPN XSEL
01800			AOS K,SCOUNT
01900			SETCMM XSEL
02000			MOVEI J,(K)
02100			MOVEM J,TCOUNT
02200			JRST .+1]
02300		SKIPE XSEL
02400		JRST[IX:MOVE AC,XDEL(I)
02500			TRNN K,1
02600			MOVN AC,AC
02700			FADRB AC,SDTH(I)
02800			FADRM AC,DDTH(I)
02900			SOJGE I,IX
03000			JRST NJ]
03100	IY:	MOVE AC,YDEL(I)
03200		TRNN K,1
03300		MOVN AC,AC
03400		FADRB AC,SDTH(I)
03500		FADRM AC,DDTH(I)
03600		SOJGE I,IY
03700	NJ:	HRRE TAC,@STKPTR
03800		ADD TAC,STKPTR
03900		SOJ TAC,
04000		HRRM TAC,STKPTR
04100		JRST NEXT
04200	
04300	TCOUNT:	0
04400	SCOUNT:	0
04500	XSEL:	0
04600	XDEL:	BLOCK 6
04700	YDEL:	BLOCK 6
04800	SDTH:	BLOCK 6
04900	
05000	HOME:	HRRE TAC,@STKPTR
05100		ADDI TAC,5(CBUF)
05200		MOVEI I,5
05300	HLN:	MOVE AC,(TAC)
05400		FADR AC,6(TAC)
05500		MOVEM AC,TFF(I)
05600		FSBR AC,T0(I)
05700		MOVNM AC,DTH(I)
05800		FADR AC,DDTH(I)
05900		SETZM DDTH(I)
06000		MOVEM AC,DELTH(I)
06100		SOJ TAC,
06200		SOJGE I,HLN
06300		MOVEI I,5
06400		MOVE TAC,DELTH+5
06500		CAML TAC,[180.0]
06600		JRST[	FSBR TAC,[360.0]
06700			JRST .-1]
06800		CAMGE TAC,[-180.0]
06900		JRST[	FADR TAC,[360.0]
07000			JRST .-1]
07100		MOVEM TAC,DELTH+5
07200		HRRE AC,@STKPTR
07300		ADDI AC,=12(CBUF)
07400		PUSHJ P,UPDC
07500		HRRE AC,@STKPTR
07600		ADDI AC,=12(CBUF)
07700		MOVE TAC,7(AC)
07800		ASH TAC,16
07900		MOVEM TAC,NTICKS
08000		MOVEI I,5
08100		SETZ MQ,
08200	HNCCA:	MOVM TAC1,DELTH(I)
08300		FMPR TAC1,TIMFAC(I)
08400		CAML TAC1,MQ
08500		MOVE MQ,TAC1
08600		SOJGE I,HNCCA
08700		FADR MQ,[20.0]
08800		FIX MQ,215000
08900		CAML MQ,NTICKS
09000		MOVEM MQ,NTICKS
09100		ASH MQ,-15
09200		ADDI MQ,=60
09300		MOVEM MQ,COUNT
09400		TRO INCREM+RUN+VZERO+NSET
09500		SETZM TICKS
09600		MOVE AC,STKPTR
09700		TRNE BOTH
09800		AOJ AC,
09900		HLRZ AC,1(AC)
10000		CAIE AC,5
10100		TRZ NSET
10200		TRZE BOTH
10300		JRST[	AOS AC,STKPTR
10400			HLRE AC,(AC)
10500			MOVEM AC,FUNCT
10600			JRST .+2]
10700		SETZM FUNCT
10800		JRST NXTJIF
10900	
     

00100	REFLEX:	MOVEI I,1
00200		MOVEI K,65B23
00300	IFN USER,<POPJ P,>
00400	REX:	PUSHJ P,PREAD
00500		LDB AC,[POINT 12,DACVAL,11]
00600		ADD AC,REF(I)
00700		MOVEM AC,OBS(I)
00800	RMOR:	SOJGE I,REX
00900		TRNN STCH
01000		POPJ P,
01100		MOVEI I,1
01200	SIT:	MOVE AC,OBS(I)
01300		JUMPG AC,[	LSH I,3
01400				IORI I,TOUCH
01500				MOVEM I,TRAJER
01600				POP P,I
01700				JRST TOFF]
01800		SOJGE I,SIT
01900		POPJ P,
02000	
02100	REF:	-1000
02200		-1000
02300		BLOCK 4
02400	OBS:	BLOCK 2
02500	SOTCHS:	0
02600	
02700	SETCH:	MOVE AC,SOTCH
02800		MOVEM AC,SOTCHS
02900		HRLE AC,@STKPTR
03000		MOVEM AC,SOTCH
03100		JUMPE AC,NEXT
03200		TRO STCH
03300		JRST NEXT
03400	
     

00100		XLIST
00200		LIT
00300		LIST
00400		END START